home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / Yerk 3.6.8 / Toolbox Classes / CtlWind < prev    next >
Encoding:
Text File  |  1995-08-16  |  3.1 KB  |  98 lines  |  [TEXT/YERK]
  1. \ 1.3.88    rfl    A window that will not scroll. This preserves the fprect
  2. \                used by fwind for scrolling.
  3. \ 11.25.90    rfl    added close: feature to nonScrollWind. This means that
  4. \                if selected and the window was from a resource, then
  5. \                the global window position will be saved in the resource,
  6. \                but the resource will not save to disk. Note that this
  7. \                defaults to window's close method.
  8. \  4.20.91    rfl    fixed close: so that if rsrc not found, rect isn't left on stack
  9. \ 10.26.91    rfl    eliminated nonscrollwind...now savewind
  10. \  1.17.91  rfl    added getnew to make the wind rsrc non purgeable if saveposition=true
  11. \  6.22.93    rfl    changed ctlhit? to handle sys 7 popup menus
  12. \  8.16.95    rfl    fixed ctlhit? to not execute popup if move mouse off of menu
  13.  
  14. create nopurge popA0 " HNoPurge" asmcall next,
  15.  
  16. :CLASS rsrcWind <super window
  17.  
  18.     int    savePosition
  19.  
  20.     :M SAVEPOSITION: put: savePosition ;M
  21.  
  22.     :M GETNEW: getnew: super get: savePosition IF get: resID getres WIND nopurge THEN ;M
  23.  
  24. \ if the window was brought up from a resource, then save the last position
  25. \  of the window in the resource, but don't save.
  26.     :M CLOSE: get: savePosition
  27.         IF set: self 0 l->g unpack     \ get global corner
  28.             getRect: self put: tempRect
  29.             offset: tempRect
  30.             get: resID getres WIND -dup                     \ is there a resource?
  31.             IF >r  get: tempRect r> >ptr put: rect THEN        \ ok, so save the window coordinates
  32.         THEN
  33.         close: super ;M
  34.  
  35. ;CLASS
  36.  
  37.  
  38. \ ctlWind - Window subclass adding controls
  39. \ 12/15/84  cbd Version 1
  40. \  9/04/86  ghs Fixed draw: -do draw: super first so controls are not erased
  41. \ 12/04/87    rfl note that ' ctlproc is correct
  42. \  1/03/87    rfl    super nonScrollWind
  43. Decimal
  44.  
  45. \ ( part# ctlHndl -- )  execute action for control
  46. : ctlExec    exec: [ get-ctl-obj ]  ;
  47.  
  48. \ procedure to be executed when a control is being tracked.
  49. \  ( ctlHndl int:part -- )
  50. :proc  ctlProc  word0 swap ctlExec  ;proc
  51. ' ctlProc value ctp
  52.  
  53. initprocs
  54.  
  55. \ Look for control click
  56. : ctlHit? { wind \ part mpoint ^ctl action1 action2 -- bool }
  57.     where: fEvent g->l -> mpoint    \ save mouse loc
  58.     Word0  mpoint wind +base
  59.     theCtl +base    call FindControl
  60.     word0 -> part  theCtl @ -> ^ctl    \ ctl handle
  61.     part inThumb = part inCheckBox = or  part inButton = or part 1 = or
  62.     IF  'c ctlExec -> action2    \ only exec after release
  63.         part 1 = IF -1 ^ctl getItem: [ get-ctl-obj ] -> part ELSE 0 THEN ->  action1 
  64.     ELSE   ctp +base -> action1
  65.         'c 2drop -> action2
  66.     THEN  ^ctl
  67.     IF word0  ^ctl  mpoint action1
  68.         call TrackControl word0
  69.         dup 1 =
  70.         IF word0 ^ctl call getCtlValue i->l part <>
  71.             IF ^ctl exec> action2 true ELSE drop false THEN 
  72.         ELSE ^ctl exec> action2 true
  73.         THEN
  74.     ELSE false
  75.     THEN ;
  76.  
  77. \ Note: if your Window is a subclass of CtlWind and has scroll bars,
  78. \ it should set the scroll bars to 255 hiliting on a deactivate event.
  79. \ This can be done via the Disable: method in VScroll.
  80. :CLASS  CtlWind  <Super rsrcWind
  81.  
  82.     \ draw the window with controls
  83.     :M  DRAW:   draw: super  (abs) call DrawControls   ;M
  84.  
  85.     \ dispose of window's controls and close the window
  86.     :M  CLOSE:  (abs) call KillControls  close: super  ;M
  87.  
  88.     \ handle a content click
  89.     :M  CONTENT:  active: self
  90.         IF  ^base ctlHit?  not
  91.             IF  exec: content THEN
  92.         ELSE  (abs) call SelectWindow
  93.         THEN
  94.     ;M
  95.  
  96. ;CLASS
  97.  
  98.